#!/usr/bin/perl -w

use strict;

use Cwd qw/ abs_path getcwd /;
use FindBin;
use lib "$FindBin::Bin";
use DICOM::DICOM;
use DCMARCH::Util qw/ Run expandTar isTarchive Meta /;
use File::Basename;
use File::Find;
use File::stat;
use Getopt::Tabular;

my $Execute = 1;
my $Debug   = 0;
my $Verbose = 0;
my $All     = 0;
my $File    = 0;
my $PrintMeta = 0;

my @DicomInfoOpt;
# The vars that we can get from the meta file, and how they are
# labeled in the meta file hash (group::var)
my %MetaOpt = (
    '-pid'      => 'STUDY_INFO::Patient_ID', 
    '-pname'    => 'STUDY_INFO::Patient_Name', 
    '-date'     => 'STUDY_INFO::Scan_Date', 
    '-studyuid' => 'STUDY_INFO::Unique_Study_ID',
    '-series'   => 'ACQUISITIONS::', # This is not a single value
    );

my $Me = fileparse($0);

my $Usage = <<USAGE;

Usage: $Me <tarchive|dicomdir> [ <tarchive|dicomdir> ... ]

USAGE

my $Help = <<HELP;

$Me Returns info from a DICOM archive (tarchive), a tarfile with DICOM
data, or from a directory with DICOM data. In case the argument is a
dicom-archive and the requested variables can all be extracted from
the .meta file in the dicom-archive, the .meta file information will
be used (fast). In other cases, and unless -all is specified, the
information will be extracted from the first valid DICOM file found in
the archive.

HELP

&Getopt::Tabular::SetHelp($Help, $Usage);

my @ArgTable = (
    ["General options", "section"],
    ["-verbose|-quiet", "boolean", 1, \$Verbose, "Be verbose"],
    ["-debug", "boolean", 1, \$Debug, "Be more verbose"],
    ["-execute", "boolean", 1, \$Execute, "Execute commands"],
    ["-all|-onefile", "boolean", 1, \$All, 
     "Check all DICOM files and return the unique results for the requested parameters"],
    ["-file", "boolean", 1, \$File, 
     "List the file or directory the data was extracted from"],
    ["-meta", "boolean", 1, \$PrintMeta, 
     "List the entire .meta file of the tarchive(s). This can only be used as a stand-alone selection option"],
    ["Variable selection options", "section"],
    ["-manufacturer", "call", undef, \&DicomInfoOption,
     "Print out the scanner manufacturer"], 
    ["-date", "call", undef, \&DicomInfoOption,
     "Print out the scan date"], 
    ["-pid", "call", undef, \&DicomInfoOption,
     "Print out the patient ID"], 
    ["-pname", "call", undef, \&DicomInfoOption,
     "Print out the patient name"], 
    ["-series", "call", undef, \&DicomInfoOption,
     "Print out the series number"], 
    ["-studyuid", "call", undef, \&DicomInfoOption,
     "Print out the study uid"], 
    ["-study_id", "call", undef, \&DicomInfoOption,
     "Print out the study ID"], 
   );

my @Args;
&GetOptions(\@ArgTable, \@ARGV, \@Args) || exit 1;

die $Usage if ! @Args;

if ($PrintMeta) {
    die "You cannot use -meta in combination with other variable selection options\n$Usage\n" if (@DicomInfoOpt);
}
else {
    die "Please select one or more variables to extract\n$Usage\n"
	if (! @DicomInfoOpt);
}

$DCMARCH::Util::Debug   = $Debug;
$DCMARCH::Util::Verbose = $Verbose;
$DCMARCH::Util::Execute = $Execute;

# Check to see if we can technically use the dicom-archive meta file
# to get our info
my $UseMeta = 1;
foreach my $opt (@DicomInfoOpt) {
    $UseMeta = 0 if (! grep(/$opt/, keys %MetaOpt));
}

my %Result;

ARG:
foreach my $arg (@Args) {
    %Result = ();

    # First check if we only want the .meta file contents
    if ($PrintMeta) {
	if (! &isTarchive($arg)) {
	    warn "-meta currently works only on tarchives; skipping $arg which is not a tarchive\n";
	    next ARG;
	}

	print &Meta($arg);
    }

    # First check if we can get the information we need from the meta
    # file, as that is much more efficient than to extract the
    # tarchive
    elsif ($UseMeta && &isTarchive($arg) && ! $All) {
	print "Extracting information from meta file of $arg\n" if $Verbose;

	my %meta;
	my $metavar = &Meta($arg, \%meta);

	die "Could not extract meta information from $arg" if (! $metavar);

	my @results;
	my @series;
	foreach my $opt (@DicomInfoOpt) {
	    my $value;
	    if (&MetaOpt($opt, \%MetaOpt, \%meta, \$value)) {
		push(@results, $value);
	    }
	    elsif ($opt =~ /series/) {
		# series could be multiple, so we have to replicate
		# other results as many times. Put a plceholder in the
		# results array
		push(@results, '_SERIES_');

		my @acq = @{ $meta{ACQUISITIONS} };

		foreach my $i (1..$#acq) {
		    push(@series, $acq[$i][0]);
		}
	    }
	}
	
	# Create a tab-separated line from the results (with placeholders)
	my $result = join("\t", @results);

	if (! @series) {
	    &NewResult($result);
	}
	else {
	    # Replicate the results lines as many times as we have series
	    # results, replacing the placeholders as we go
	    foreach my $ser (@series) {
		my $newresult = $result;
		
		$newresult =~ s/_SERIES_/$ser/g;
		
		&NewResult($newresult);
	    }
	}
    }
    else {
	# Unfortunately we can't use the meta file, so let's extract
	# the archive
	my $dicomdir = abs_path($arg);
	if (-f $arg && ($arg =~ /\.tar(\.gz)?$/)) {
	    $dicomdir = &expandTar($dicomdir);
	}
	elsif (! -d $arg) {
	    warn "Argument $arg is not a tarball nor a directory; skipping\n";
	    next ARG;
	}
    
	# Process all files in the dir
	find(\&FileProcessor, $dicomdir);
	
	unlink $dicomdir unless ($dicomdir eq $arg);
    }

    if ($File) {
	foreach my $res (sort keys %Result) {
	    print "$arg\t$res\n";
	}
    }
    else {
	print join("\n", sort keys %Result) . "\n";
    }
}

#==========================================================
# Subroutines
#==========================================================

sub DicomInfoOption {
    my ($option) = @_;

    push(@DicomInfoOpt, $option);

    1;
}
   
sub FileProcessor {
    my $file = $_;
 
    return if (! $All && keys %Result);

    if (-f $file) {
	my $result = `$FindBin::Bin/get_dicom_info.pl @DicomInfoOpt $file`;
	chomp $result;
	
	&NewResult($result);
    }
}

sub NewResult {
    my $result = shift;
	
    if (! defined $Result{$result}) {
	$Result{$result} = 1;
    }
    else {
	$Result{$result}++;
    }
}

sub MetaOpt {
    my ($opt, $metaoptref, $metaref, $valref) = @_;

    return 0 if (! defined $$metaoptref{$opt});

    if ($$metaoptref{$opt} =~ /^(.+)::(.+)$/) {
	my $group = $1;
	my $var = $2;

	if (defined $$metaref{$group}{$var}) {
	    my $val = $$metaref{$group}{$var};
	    
	    $val =~ s/\-//g if ($opt =~ /^-date$/);

	    $$valref = $val;
	    return 1;
	}
    }
    
    return 0;
}
